home *** CD-ROM | disk | FTP | other *** search
/ Almathera Ten Pack 3: CDPD 3 / Almathera Ten on Ten - Disc 3: CDPD3.iso / fish / 001-100 / 001-025 / 018 / xlisp1.6 / init.lsp < prev    next >
Lisp/Scheme  |  1995-03-17  |  2KB  |  71 lines
  1. ; initialization file for XLISP 1.6
  2.  
  3. ; get some more memory
  4. (expand 1)
  5.  
  6. ; some fake definitions for Common Lisp pseudo compatiblity
  7. (setq first  car)
  8. (setq second cadr)
  9. (setq rest   cdr)
  10.  
  11. ; (when test code...) - execute code when test is true
  12. (defmacro when (test &rest code)
  13.           `(cond (,test ,@code)))
  14.  
  15. ; (unless test code...) - execute code unless test is true
  16. (defmacro unless (test &rest code)
  17.           `(cond ((not ,test) ,@code)))
  18.  
  19. ; (makunbound sym) - make a symbol be unbound
  20. (defun makunbound (sym) (setq sym '*unbound*) sym)
  21.  
  22. ; (objectp expr) - object predicate
  23. (defun objectp (x) (eq (type-of x) :OBJECT))
  24.  
  25. ; (filep expr) - file predicate
  26. (defun filep (x) (eq (type-of x) :FILE))
  27.  
  28. ; (mapcan fun list [ list ]...)
  29. (defmacro mapcan (&rest args) `(apply #'nconc (mapcar ,@args)))
  30.  
  31. ; (mapcon fun list [ list ]...)
  32. (defmacro mapcon (&rest args) `(apply #'nconc (maplist ,@args)))
  33.  
  34. ; (set-macro-character ch fun [ tflag ])
  35. (defun set-macro-character (ch fun &optional tflag)
  36.     (setf (aref *readtable ch) (cons (if tflag :tmacro :nmacro) fun))
  37.     t)
  38.  
  39. ; (get-macro-character ch)
  40. (defun get-macro-character (ch)
  41.   (if (consp (aref *readtable* ch))
  42.     (cdr (aref *readtable* ch))
  43.     nil))
  44.  
  45. ; (save fun) - save a function definition to a file
  46. (defmacro save (fun)
  47.          `(let* ((fname (strcat (symbol-name ',fun) ".lsp"))
  48.                  (fval (car ,fun))
  49.                  (fp (openo fname)))
  50.                 (cond (fp (print (cons (if (eq (car fval) 'lambda)
  51.                                            'defun
  52.                                            'defmacro)
  53.                                        (cons ',fun (cdr fval))) fp)
  54.                           (close fp)
  55.                           fname)
  56.                       (t nil))))
  57.  
  58. ; (debug) - enable debug breaks
  59. (defun debug ()
  60.        (setq *breakenable* t))
  61.  
  62. ; (nodebug) - disable debug breaks
  63. (defun nodebug ()
  64.        (setq *breakenable* nil))
  65.  
  66. ; initialize to enable breaks but no trace back
  67. (setq *breakenable* t)
  68. (setq *tracenable* nil)
  69.  
  70.  
  71.